perm filename MS.F4[IRC,LCS] blob
sn#493210 filedate 1980-01-12 generic text, type T, neo UTF8
C ********** DISPLAYS MUSIC AND DRAWS IT ON THE PLOTTER **********
C *** READS DATA FROM CLEFA-B-C-ETC., BDR40,BDI40, ETC.
IMPLICIT INTEGER(A-Q,S-Z)
REAL DIS,DISX,A,B,STFF,CENTR,POS ,UD,XDIS
DIMENSION LST(18),DP(0/7)
COMMON /DL/X22,SAVER,NAME,EXT,IOLD /RRJJ/RJJ2,RJJ(20),JJA
1 /FONT/JFONT /RINP/R(10,80),RPOS(2,50),RI(200)
2 /RMOD/RMODE2,RSET4,IBEAM,
3 NOSET,STEM,STUP,NTC,ENDP,RAD,RDD,ITB,POSB
4 /FRMT/F78F(1),FA1(1),FA5(1),ASK /SIZ/RSZ,JCEN,KCEN
C ORDER OF COMMON MUST! REMAIN AS IS (FOR DMP MODE READ)
COMMON /LIMIT/LIMIT,ITEM,L,I,IX,ITEMX,ILIM
1 /STF/RSTFAC(0/7),RSTJ2
2 /POSI/STFF(0/7),JJ2,POS /ALF/INP(72),ML
3 /SCM/V(30),IV(48),ISCR,LCNT,RSTF,LIST(200),REND
4 /UPDWN/ RL,UD /IDEV/IDEV /NUM/NUM(10),JRD
5 /PLTR/PLT,RHT,DIS,XDIS /PTR/PWDS(350)
CC COMMON /PLTR/PLT,RHT,DIS,XDIS/PTR/PWDS(250),ITEM,L,I,IX
COMMON/A2Z/LAA,LBB,LCC,LDD,LEE,LFF,LGG,LHH,LII,LJJ,LKK,LEL,
1 LMM,LNN,LOH,LPP,LQQ,LRR,LSS,LTT,LUU,LVV,LWW,LXX,LYY,LZZ
2 /JCHAR/IXX,ISEMI,IBLA,IG,JED,KED,REDIT,RITEM
COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /RNW/RNW /MKS/MKS(14)
1 /XRN/RN(3000) /DPY/NDP,ST2,IOV,MEDIT,IGO /DPTR/WDS(350)
2 /MKX/MKX(11) /SC/SSC(72) /YED/YED,IBOX,RBOX/JCLIP/JCLIP
CC COMMON/XRN/RN(2500)/DPY/ST(4000),WDS(250),MEDIT,IGO
EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R5,RJQ(3)),(I4,
1 INP(4)),(R6,RJQ(4)),(J10,JQ(8)),(J6,JQ(4)),(R4,RJQ(2)),(R7,
2 RJQ(5)),(R3,RJQ(1)),(I2,INP(2)),(I1,INP(1)),(I3,INP(3)),
3 (RJ13,RJJ(11))
4,(R11,RJQ(9)),(NJR,R10,RJQ(8)),(R8,RJQ(6)),(RJ3,RJJ(1)),(R9,
5 RJQ(7)),(RX3,RJQ(20)),(R13,RJQ(11)),(J8,JQ(6))
6 ,(J13,JQ(11)),(IPOS,POS),(LST(13),K),(LST(14),X),(LST(15),J)
7 ,(I7,INP(7)) ,(ISTAR,MKX(11))
1 ,(MINUS,MKX(10)),(LESS,MKX(3)),(IGT,MKX(4)),(RJ7,RJJ(5))
DATA NUM/'0','1','2','3','4','5','6','7','8','9'/,JRD/0/,ILIM/350/
1 ,STFF/-469.,-346.,-223.,-100.,23.,146.,269.,392./,RSTFAC/8*1./
2 ,LST/'NOTE','REST','CLEF','LINE','SLUR','BEAM','TRILL','STAFF',
3 'MISC','NUMB','LIBRY','CIRCL',0,0,0,'WORD','KSIG','METER'/
4 ,DP/8*1/,RNW/2.44/,LCNT/1/,LIMIT/3000/,DIS/1.0/, RHT/1.0/
5 ,PLUS/'+'/,EXT/'MS'/,COMMA/','/
DATA MKS/'W','A','F','S','M','T','D','U','H','I','P','C','R','O'/
C THE GIANT NUMBERS ARE FOR [ AND ]
DATA MKX/'/',';','<','>',-19728949184,-18655207360,'(',')','.'
1,'-','*'/,SSC(14)/'X'/,SSC(15)/';'/,SSC(72)/' '/
C LIMIT IS MAIN ARRAY LENGTH (3000)
C 350 LIM. ON ITEMS PWDS, WDS (SEE ALSO 571 TO 170)
CALL ERRSET(0)
C AVOID INTEGER OVERFLOW MESSAGES
CXX DPSTOP=0
CXX IOV=1
C IOV IS FOR OVERLAYS. (WRITES IN OVERLAY BUFFER IF IOV=2)
CXX LCEN=0
CXX MCEN=0
CALL BEGMS
K=1
CALL DPYSET(4000,K)
10 CALL DELVEC(1,0)
C DELETES ALL VECTORS TO END OF BUFFER
CALL HYDDPY
NDP=0
C NDP IS POINTER TO LAST USED PLACE IN DPY BUFFER
C NDP IS DISPLAY BUFFER NUM. 1=REGULAR, 2=OVERLAY
DPYIT=0
C DPYOUT FLAG
DO 20 K=1,I
CLEARS ARRAY FOR RESTART OF 'SETUP' ROUTINE
20 RN(K)=0
JFONT=0
CHNG=0
C flag for edit changes (=-1 means a change has been made.)
IOLD=0
C IOLD HOLDS LAST ITEM NUM. EDITED.
IX=0
RSET4=999
QUICK=0
CB=0
C CB IS CENTER-BIG (CENTERING RANGE=6)
UD=1
RL=1
FSCN=LEL
RPOS(1,1)=0
RSZ=.845
JCLIP=525
X22=0
MINUZ=0
C MINUZ IS FLAG FOR '-' SETTING CRLF BACKUP FEATURE (WHEN IN EDIT MODE)
JCEN=0
KCEN=0
PLT=0
PWDS(1)=1
EDQ=-1
RN(2)=0
C FOR RESTART. AVOIDS STAFF CODE NUM.
SAVER=4
DO 30 K=0,7
30 RSTFAC(K)=1.
REDIT=999.
M=1
ITEM=0
ITEMX=0
ZERO=-1
WDS(1)=1
C DATA IN DPY ARRAY STARTS AT WD.1
I=1
40 SCORE=-1
50 IGO=-1
IF(I1.NE.LRR)GO TO 130
I1=-1
CALL NAMEXT(INP,NAME,EXT)
J2=0
IF(NAME.NE.IBLA)GO TO 2250
C YOU CAN TYPE 'RS NAME' FOR QUICK RESTARTS
GO TO 130
60 CALL NOTWRT
70 ITEM=ITEM+1
CALL VECCNT(ST2)
C UPDATE THE VECTOR COUNTER
IF(ITEM.LT.ILIM)GO TO 90
CALL TYPSTR('**** TOO MANY ITEMS')
CALL TYPINT(ITEM)
CALL TYPSTR('/349')
CALL TYPCRL
I=PWDS(ILIM)
ITEM=ILIM-1
ST2=WDS(ILIM)-1
CALL DELVEC(WDS(ILIM),0)
C CLEAR ALL VECTORS FROM END OF BUFFER.
CALL DPYOUT(NDP)
C******* ABOVE FOR OVERLOAD. TEST THIS!!! **********************
GO TO 40
90 IF(IGO.GT.0)GO TO 100
K=ST2
IF(X22.EQ.0)GO TO 100
CALL DPYOUT(NDP)
CALL BOX(IBOX,RBOX)
DPYIT=0
C DOES A DPYOUT WHEN DRAWING CURSOR, SO DON'T AT 120
ST2=K
CALL DELVEC(ST2+1,0)
100 WDS(ITEM+1)=ST2+1
IF(EDQ.LT.0)GO TO 110
IF(M.LT.I)GO TO 2370
C SL=SAVE AFTER RESETTING LENGTH OF PAGE. (SEE I2 IN SCX)
110 PWDS(ITEM+1)=I
PLT=0
IF(X22.NE.0)GO TO 120
C*** IF(IDEV.EQ.5)GO TO 115
C NO DPYOUT YET IF READING FILE AND IN SCORE INPUT MODE.
IF(EDQ.LT.0.AND.SCORE.EQ.0)GO TO 1000
115 CALL DPYOUT(NDP)
NDP=ST2
C SO WE ONLY ADD NEXT ITEM TO DPY BUF.
IF(SCORE.EQ.0)GO TO 1000
C GO GET MORE FROM SCX.
IGO=-1
120 IF(SCORE.EQ.0)GO TO 1070
C SCORE=0 WHEN IN "SCORE" MODE, ELSE =-1
IF(DPYIT.LT.0)CALL DPYOUT(NDP)
DPYIT=0
130 SVST=ST2
C CATCHES TYPO WITH 'C'
K=ITEM+1
IF(X22.EQ.0)GO TO 250
C 'N' SUPPRESSES TYPE-OUT, 'P' OR NEW ITEM RESTORES IT.
IF(QUICK)140,140,290
C -1=QUICK MODE, +1=SUPPRESS TYPE-OUT OF PARAMS, 2=AS 1, BUT RESETS AT C
140 L=RN(MEDIT+1)
K=X22
IF(IDEV.EQ.1)GO TO 290
C 'FILE' OR 'READ' CAN BE USED WHILE IN EDIT MODE
CALL TYPCRL
CALL TYPWRD(LST(L))
CALL TYPCRL
CALL TYPFLT(RN(MEDIT+1))
CALL TYPCHR(' ',3)
CALL TYPFLT(RN(MEDIT+2))
CALL TYPCHR(' ',3)
CALL TYPFLT(RN(MEDIT+3))
CCCCC TYPE 1427,(RN(L),L=MEDIT+1,MEDIT+3)
IF(YED.LT.2)GO TO 260
C YED IS SET AT 426
DO 150 L=4,YED+2
CALL TYPCHR(' (',4)
CALL TYPINT(L)
CALL TYPCHR(') ',2)
150 CALL TYPFLT(RN(MEDIT+L))
CALL TYPCRL
CCC5501 TYPE 4271,L,RN(MEDIT+L)
GO TO 260
190 FORMAT(2A5)
200 REREAD 190,K,K
C*********************************************************
IF(I4.NE.LPP)GO TO 210
C****************** CALL HELP(K)
GO TO 130
210 CALL LO2UP(K)
C CHANGES LOWER CASE TO UPPER CASE
IF(K.NE.IBLA)GO TO 215
K=FILNAM
CALL TYPSTR('READING ')
CALL TYPWRD(K)
CALL TYPCRL
215 FILNAM=K
C SAVE NAME FOR LATER USE. 'READ' ALONE READS PREVIOUS FILE.
IF(LOOK(K)+LOOKD(K))GO TO 220
CALL TYPSTR(' FILE NOT FOUND')
GO TO 260
CC2502 CALL IFILE(1,K)
220 CALL FILX(K)
C GOBBLES ET HEADEROR CONVERTS SOS FILE
230 IDEV=1
GO TO 290
240 IDEV=5
IF(X22.NE.0)GO TO 330
GO TO 260
C RESET TO TTY MODE
250 KED=0
QUICK=0
C RESET PARAM TYPE-OUT
RJ13=0
C KILL CENTERING FEATURE FOR NOW
260 IF(IDEV.EQ.1)GO TO 290
CALL TYPCRL
IF(X22.EQ.0)GO TO 270
CALL TYPSTR('**** EDIT ITEM #')
CALL TYPINT(K)
GO TO 280
270 CALL TYPWRD(NAME)
CALL TYPSTR(' TYPE FOR ITEM #')
CALL TYPINT(K)
CALL TYPSTR(' ')
CALL TYPINT(I)
CALL TYPSTR(' ')
CALL TYPINT(SVST)
280 CALL TYPCRL
290 SCORE=-1
CQQ ACCEPT 89,INP
READ(IDEV,700,END=240)INP
CALL LULOOP
CALL RREAD(INP,V)
C ABOVE TO MAKE UP FOR LOSS OF REREAD FEATURE
IF(I1.EQ.LESS)GO TO 240
C '<' = TEMPORARY ESCAPE FROM 'READ' MODE
IF(I1.NE.IGT)GO TO 300
IF(X22.NE.0)GO TO 260
C '>' = RETURN TO 'READ' MODE - IF NOT STILL EDITING.
GO TO 230
300 IF(IDEV.EQ.5)GO TO 320
IF(I7.NE.LTT)GO TO 320
IF(I1.NE.LCC)GO TO 320
C 'ET' DIRECTORY? UGH!!!
310 READ(IDEV,700)INP
IF(I3.NE.ISEMI)GO TO 310
READ(IDEV,700)INP
C READ AGAIN TO GET PAGE MARK - OR SOMETHING???
GO TO 290
320 CALL NUMLTR(1,J)
C NUMLTR SENDS BACK STUFF IN R2,RJQ (3=SKIPS 3 LETTERS)
C FIRST CATCHES BLANKS, NUMBERS, ETC.
330 IF(I1.GT.COMMA)GO TO 900
IF(I1.NE.IBLA)GO TO 333
J=0
GO TO 900
333 IF(I1.EQ.LII)GO TO 740
C IN, ITEM
IF(I1.EQ.IXX)GO TO 640
C X=EXIT
IF(I1.EQ.LEL)GO TO 680
C L=LEFT, LP=LIGHT PEN
IF(I1.EQ.LUU)GO TO 680
C UP
IF(I1.EQ.LRR)GO TO 660
C R=RIGHT, RI=RIT, READ, RS=RESTART
IF(I1.EQ.LDD)GO TO 360
C D=DOWN, DI=DIM, DE=DELETE
IF(I1.EQ.LCC)GO TO 1740
C C=COPY, CR=CRESC., CN=CENTER, CB=CENTER BIG, CH=ON HEAD, CT=ON TAIL
IF(I1.EQ.LSS)GO TO 490
C SAVE, SPACING STAFF, STAFF, SHOW, SF, SFZ, SCALE, STC=STACCATO
IF(I1.EQ.LEE)GO TO 540
C ED=EDIT WITH POS. FIRST, E=EDIT WITH LIGHT PEN, ES=EDIT WITH STAFF NUM
IF(I1.EQ.LNN)GO TO 710
C N=NO TYPE
IF(I1.EQ.LPP)GO TO 1150
C P,PP,PPP, P N=PRINT PARAM N., PR=PRINT PARAM LIST, POCO, PIU, PZ=PIZZ,
IF(I1.EQ.LAA)GO TO 350
C A=ADJUST TO SET, AD=ADJUST STEMS, AC=ACCEL, AR=ARCO, AT=A TEMPO, ACT=A
IF(I1.EQ.LTT)GO TO 770
C T=TYPE TEXT, T=TYPE OUT, TE=TENUTO
IF(I1.EQ.LFF)GO TO 870
C F,FF,FFF,FE=FERMATA,FILE(TO READ COMMAND FILE)
IF(I1.EQ.LHH)GO TO 840
C H=HARMONIC, HW=HEAVY WEDGE, HELP
IF(I1.EQ.COMMA)GO TO 1460
C VALUE OF COMMA IS > VALUE OF PLUS
IF(I1.GE.PLUS)GO TO 900
IF(X22.NE.0)GO TO 260
C NEXT CANNOT HAPPEN IN EDIT MODE.
IF(I1.NE.LOH)GO TO 340
C NEXT FOR REORDERING ITEMS FROM LEFT TO RIGHT, BY STAFF. THEN IT DOES A
IF(I2.EQ.LXX)R2=1
C OX=ORDER WITHOUT REGARD FOR STAFF NUM.
CALL ORDER
340 IF(I1.EQ.LZZ)GO TO 1170
C ZOOM
IF(I1.EQ.LMM)GO TO 1770
C M=MOVE, ME=MENO, MO=MOLTO, MF,MP
IF(I1.EQ.LJJ)GO TO 1770
C JUSTIFY
IF(I1.EQ.LGG)GO TO 2220
C GET, GM=GET MORE
IF(I1.EQ.LWW)GO TO 850
C W=WEDGE ACCENT
IF(I1.EQ.'(')GO TO 1430
IF(I1.EQ.')')GO TO 1450
C LEFT AND RIGHT PARENTHESES
IF(I1.NE.LBB)GO TO 260
C******* ADD MORE LETTER ITEMS HERE *************
C BRC=BRACE, BRK=BRACKET -- FOR FRONT OF LINE. BAR=BAR LINE.
IF(X22.NE.0)GO TO 260
CALL NUMLTR(3,J)
C NUMLTR SENDS BACK STUFF IN R2,RJQ (3=SKIPS 3 LETTERS)
J=4
R7=5
IF(I3.NE.LCC)R7=4
IF(I3.EQ.LRR)R7=0
GO TO 900
350 IF(I2.EQ.LDD)GO TO 570
C 'A' = ALTER(GO TO 112) ADJUST(GO TO 886) ACCEL(GO TO 7813)
C ALIGN=GO TO 886
IF(X22.NE.0)GO TO 580
IF(I2.EQ.LTT)GO TO 1410
C AT=A TEMPO
IF(I2.EQ.LRR)GO TO 1420
C AR=ARCO
IF(I2.NE.LCC)GO TO 1060
IF(I3.EQ.LTT)GO TO 810
C ACT=ACCENT. NEXT FOR AC (=ACCEL.)
RD=80
GO TO 880
360 IF(I2.GE.IBLA)GO TO 650
C 'D' DIM →578, DOWN →883, DELETE →112 OR 883 DP →886
IF(I2.NE.LEE)GO TO 370
IF(X22.NE.0)GO TO 650
GO TO 1060
370 IF(I2.EQ.LPP)GO TO 570
IF(I2.NE.LII)GO TO 260
C NEXT FOR DIM.=82
IF(X22.NE.0)GO TO 260
RD=82
GO TO 880
C 'S'=SET, SA=SAVE, SB=SAVE BIG, SM=BIG+SAME NAME, ST=STAFF, SP=SPC STF
C SC=SPACING SCALE ABOVE STAFF n (99=DELETE IT)
490 IF(I2.EQ.LTT)GO TO 561
IF(I2.EQ.LAA)GO TO 520
IF(I2.EQ.LCC)GO TO 580
IF(I2.EQ.LDD)GO TO 520
IF(I2.EQ.LEE)GO TO 530
IF(I2.EQ.IBLA)GO TO 530
IF(I2.EQ.LPP)GO TO 730
IF(I2.EQ.LHH)JFONT=1
IF(I3.EQ.IXX)JFONT=0
IF(I3.EQ.LPP)JFONT=-1
IF(I3.EQ.LOH)JFONT=-2
IF(I3.EQ.LII)JFONT=-3
C 'SH'(=SHOW) IS SAME AS 44 1. SHOWS TYPE FONTS ON DPY.
C 'SHP' = SHOW ONLY AS 'PRIMITIVE' FONT, 'SHX' = CANCEL FONTS ON DPY.
C 'SHO' = FONT SET (TEMPORARILY) TO 'BDR'; 'SHI' = 'BDI' (ITALICS)
IF(I2.NE.LFF)GO TO 510
RD=45
IF(I3.NE.LZZ)GO TO 880
RD=92
500 CALL NUMLTR(3,JA)
C NUMLTR SENDS BACK STUFF IN R2,RJQ (3=SKIPS 3 LETTERS)
R5=RD
GO TO 890
510 IF(I2.NE.LMM)GO TO 130
C ONLY FOR ST, SA, SB, SM, RS, S, SF=45, SFZ=92
520 IF(X22.NE.0)GO TO 130
SAVER=4
CALL SAVIT
GO TO 130
530 JA=55
R2=RN(MEDIT+3)
C POSITION OF ITEM LOOKED AT.
R3=55.
GO TO 1110
C ABOVE FOR 'S'ET ALIGNMENT
C 'S'=SET ALIGNMENT, 'A'=ALIGN IT. 'M'=MOVER 'C'= COPIER
C 'E'=EDIT; 'I'=ITEM; 'G'=GET; 'GM'=GET MORE;
540 K=-1
DO 550 JA=3,10
550 IF(INP(JA).NE.IBLA)GO TO 570
GO TO 650
560 FORMAT(A2,21F)
CC IF(X22.NE.0)GO TO 59
561 IF(I3.EQ.LCC)GO TO 830
C STC=STACCATO
570 IF(CHNG.NE.0)GO TO 130
C CAN'T DO 'ST' AND OTHER THINGS AFTER CHANGES IN EDIT MODE.
580 CALL NUMLTR(2,J)
C NUMLTR SENDS BACK STUFF IN R2,RJQ (2=SKIPS 2 LETTERS)
JA=55
IF(I2.NE.LCC)GO TO 590
CALL SCL
GO TO 130
590 IF(I2.NE.LDD)GO TO 600
IF(I1.EQ.LAA)JA=190
C 'AD'just stems to beams.
600 IF(I2.EQ.LTT)JA=44
IF(I2.EQ.LNN)GO TO 950
IF(I2.NE.LPP)GO TO 1110
IF(R2.GT.7)GO TO 620
C GO BACK AND RESET ALL IF STF NUM >7
K=R2
JA=0
C USE '8' FOR STAFF 0.
IF(K.GE.0)GO TO 610
CXX DPSTOP=-1
C**** IRCAM ***** DPSTOP =STOP ALL DPY ****** IN MSDPY.F4
GO TO 260
610 IF(K.EQ.8)K=0
CXX DPSTOP=0
DP(K)=-DP(K)
JA=JA+1
K=RJQ(JA)
IF(K.EQ.0)GO TO 120
C JUMP OUT IF RJQ(JA)=0 OR 99
IF(K.EQ.99)GO TO 1320
C*** 3/74 END WITH '99' TO MAKE DP RIGHT NOW!
GO TO 610
620 DO 630 K=0,7
630 DP(K)=1
GO TO 1320
C TO GET BACK OTHERS - 'DPY N' AGAIN WILL DO.
C 'LP'=LIGHT PEN. TO BE USED ONLY IN EDIT MODE
640 IF(X22.EQ.0)GO TO 260
C 'X' GO BACK IF NOT IN EDIT MODE -- ALSO R,L,U,D
MINUZ=0
C CLEAR MINUS SIGN FLAG
C NEXT FOR READ, RS, DEL, L,R,U,D
650 IF(IX.EQ.I)GO TO 670
C CAN'T DELETE ('DE') AFTER A PARAM HAS BEEN CHANGED. START OVER.
IF(I2.NE.LEE)GO TO 680
GO TO 130
660 IF(I2.GE.IBLA)GO TO 680
C R=RIGHT MOVE, RI=RIT., RS=RESTART, READ=READ
IF(I2.EQ.LEE)GO TO 200
C ABOVE FOR 'READ'(SAME AS 'FILE') (CAN 'READ' WHILE IN EDIT MODE!!)
IF(X22.NE.0)GO TO 260
C GO BACK IF STILL IN EDIT MODE.
IF(I2.EQ.LSS)GO TO 10
C TYPE 'RS' TO RESTART. NEXT FOR RIT.=37
RD=37
GO TO 880
670 IF(I1.EQ.LCC)GO TO 1650
680 IF(I1.EQ.LEE)GO TO 690
C ABOVE FOR 'ED' (WITH LIGHT PEN)
IF(X22.EQ.0)GO TO 130
C CAN'T MOVE ITEMS UNLESS REALLY IN EDIT MODE!
IF(QUICK.EQ.0.AND.I2.NE.LEE)QUICK=2
C NOW PARAMS DON'T PRINT OUT WHEN USING L,R,U,D***(BUT DE=DELETE)
690 CALL EDIT(JJA)
IF(JA.NE.99)GO TO 1110
NDP=WDS(X22)
CALL DELVEC(NDP,WDS(X22+1)-1)
C DELETES VECTORS FOR THIS ITEM FROM DISPLAY BUFFER.
CALL DELETE
C DELETE ROUTINE (FAIL) COULD BE PUT DIRECTLY IN HERE.
NDP=NDP-1
C ABOVE REDRAWS AFTER DELETE ONLY WHAT IS NECESSARY.
CALL DPYOUT(NDP)
DPYIT=0
GO TO 1700
700 FORMAT(72A1)
C TYPE L, R, U OR D OR EDIT TO MOVE LAST ENTERED ITEM.
710 IF(QUICK.NE.0)GO TO 720
C ↑↑↑ SO 'N n' WILL WORK EVEN AFTER N HAS BEEN SET.
QUICK=1
C TYPE 'N' =NO-TYPE PARAMS TO SUPPRESS TYPE-OUT WHILE EDITING.
IF(X22.NE.0)GO TO 730
720 I1=LII
C 'N n' WHEN NOT IN EDIT MODE = 'I n'<CR>,'N'<CR>
730 IF(I1.NE.LII)GO TO 750
740 IF(I2.EQ.LNN)GO TO 570
JA=223
C JA=223 FOR EDIT MODE
IF(CHNG.NE.0.OR.ITEM.EQ.0)GO TO 130
C AFTER A CHANGE OF AN ITEM, 'I', ETC. IS ILLEGAL.
GO TO 1110
750 IF(K)JA=55
C ED 47 -1 = 55 47 -1, ETC.
IF(JA.EQ.101)GO TO 590
IF(I1.NE.LNN)GO TO 760
IF(R2.NE.0)GO TO 720
C IF NO NUM FOLLOWS 'N' GO PRINT OUT CURRENT PARAMS.
GO TO 290
C 'Z' = ZOOM (OLD CODE# 24)
760 IF(I2.NE.LPP)GO TO 770
RSET4=R3
C SPn SETS "SETUP" STAFF NUMBER
GO TO 130
C 'SP' IS SAME AS 444
C 'P n' = PRINT CURRENT CONTENTS OF PARAM n. (ONLY WHILE IN EDIT MODE.)
770 IF(X22.EQ.0)GO TO 910
QUICK=0
C TYPE 'T' TO RESET PARAM TYPE-OUT
IF(R2.EQ.0)GO TO 130
GO TO 720
780 RD=14
C PLUS
790 CALL NUMLTR(2,J)
C NUMLTR SENDS BACK STUFF IN R2,RJQ (2=SKIPS 2 LETTERS)
800 IF(X22.NE.0)GO TO 130
C CAN'T ENTER NEW ITEM WHILE IN EDIT MODE.
J=9
R5=RD
IF(R4.EQ.0)R4=15
GO TO 900
810 RD=5
C ACCENT
820 CALL NUMLTR(3,J)
C NUMLTR SENDS BACK STUFF IN R2,RJQ (3=SKIPS 3 LETTERS)
GO TO 800
830 RD=7
C STACC.
GO TO 820
840 IF(I3.EQ.LEL)GO TO 200
C JUMP FOR HELP
IF(X22.NE.0)GO TO 260
C CAN'T DO NEXT IF STILL IN EDIT MODE.
RD=13
C HARMONIC
IF(I2.EQ.LWW)RD=21
C HEAVY WEDGE
GO TO 790
850 RD=4
C WEDGE
GO TO 790
860 CALL NUMLTR(2,J)
C NUMLTR SENDS BACK STUFF IN R2,RJQ (2=SKIPS 2 LETTERS)
R5=26
J=9
IF(R4.EQ.0)R4=12
C FERMATA
GO TO 900
870 IF(I2.EQ.LII)GO TO 200
IF(X22.NE.0)GO TO 260
R5=51
C F=51 FF=52 FFF=53, FE=FERMATA, FILE
IF(I2.EQ.IBLA)GO TO 890
IF(I2.EQ.LEE)GO TO 860
RD=53
IF(I3.NE.IBLA)GO TO 500
RD=52
880 CALL NUMLTR(2,J)
C NUMLTR SENDS BACK STUFF IN R2,RJQ (2=SKIPS 2 LETTERS)
R5=RD
890 J=3
IF(R4.EQ.0)R4=-5
C ABOVE IS FOR DIRECT TYPING OF P,PP,PPP,MP,RIT., ETC.
C IF PARAM 4 IS 0, PUTS IT -5 BELOW.
900 JA=J
IF(JA.GT.0)SAVER=SAVER-1
IF(SAVER.LT.0.AND.CHNG.LT.0)CALL SAVIT
C SAVES EVERY 5TH TIME AROUND (IF NO HANGING CHANGES IN DATA)
IF(QUICK.EQ.2)QUICK=0
C RESET QUICK(SUPRESSES PARAM PRINTOUT) IF CRLF AFTER L,R,U,D
IF(X22.NE.0)GO TO 1110
IOLD=0
C RESET FLAG FOR "I" COMMAND
IF(JA.EQ.0)GO TO 130
C CATCHES ZEROS
GO TO 1110
C NEXT FOR ALPHA TEXT ITEMS. 'T'=TYPE
910 IF(I2.NE.LEE)GO TO 920
RD=9
C TENUTO
GO TO 790
920 JA=16
C 'T' = TYPE IN TEXT
J2=R2
M=I
CALL WORDS
SAVER=SAVER-1
IOLD=0
GO TO 1345
950 IF(X22.NE.0)GO TO 130
JA=140
RMODE2=R3
C TYPE 'IN STF# MODE' ETC. -- SAME AS 140 STF#.
960 SCORE=0
IF(JA.NE.140)GO TO 990
C NEXT PUTS UP STAFF IF IT WASN'T THERE ALREADY
SAVER=-1
RSTF=R2
IF(R3)R3=0
DO 970 K=1,ITEM
J=PWDS(K)
IF(RN(J+1).NE.8)GO TO 970
IF(RN(J+2).EQ.R2)GO TO 980
970 CONTINUE
C DIDN'T FIND THIS STAFF
M=LIMIT
C ↑↑ WAS =2000 6/78
IGO=0
JA=8
R3=0
GO TO 1110
977 CALL DPYOUT(NDP)
C DISPLAY STAFF
980 JA=140
ITCHK=ITEM
ICHK=I
IDPY=ST2
C ALL THIS FOR BACKUPS
990 SPD=ST2
JIT=ITEM
ISC=I
REND=0
C RETAINS ORIGINS OF SCORE SQUENCE
1000 IF(REND.EQ.2)GO TO 990
C FOR READIN CONTINUATION.
M=ISC
1010 IF(JA.EQ.8)GO TO 977
IF(REND)GO TO 1050
C REND=0 GO, -1=NORMAL END, 1=ABORTED.
CALL SCMSS
IOLD=0
IF(REND.EQ.1)GO TO 1050
IF(REND.NE.99)GO TO 1020
I=ICHK
ITEM=ITCHK
ST2=IDPY
CALL DELVEC(ST2,0)
ST2=ST2-1
CALL DPYOUT(NDP)
GO TO 1050
1020 ITEM=JIT
J=M
1030 ITEM=ITEM+1
PWDS(ITEM)=J
J=J+RN(J)+3
IF(J.LT.I)GO TO 1030
IF(IBEAM)GO TO 1040
R13=0
R2=RSTF
JA=190
J3=0
CALL HOMER
1040 ITEM=JIT
ST2=SPD
CALL DELVEC(ST2,0)
ST2=ST2-1
NDP=SPD
C SO WE DON'T REBUILD MORE THAN NEEDED OF DPY.
GO TO 1345
1050 SCORE=-1
CALL SHRINK(JIT)
C GETS RID OF ZEROS AT END OF NOTE PARAM LIST.
IGO=-1
JA=16
C FOR TRAP AT 'EDIT'
GO TO 130
1060 IGO=1
CALL GRED
JFONT=0
IF(JA.EQ.98)GO TO 1080
KNT=0
SCORE=0
1070 KNT=KNT+1
C NUM OF ITEMS IN LIST
R11=0
R10=0
R9=0
JA=R(1,KNT)
R2=R(2,KNT)
IF(JA.NE.0)GO TO 1090
C =0 MEANS NO MORE ITEMS.
C*** IF(IDEV.EQ.1)GO TO 40
C JUMP IF READING A FILE, ELSE REBUILT ENTIRE DPY
NDP=0
CALL DPYOUT(NDP)
GO TO 40
1080 X22=0
IGO=-1
NDP=0
C TO REBUILD DPY. (BETTER TO SET THIS IN GRED.
C (NO NEED TO REDO ENTIRE DPY!
DPYIT=-1
CXX CALL DPYNEW
GO TO 120
1090 DO 1100 K=1,6
1100 RJQ(K)=R(K+2,KNT)
1110 M=1
EDQ=-1
IF(JA.EQ.222)GO TO 1650
IF(JA.EQ.2222)GO TO 1670
DO 1120 K=1,20
1120 JQ(K)=RJQ(K)
C X22= ITEM# WHEN EDITING OR DELETING.
IF(X22.NE.0)GO TO 1610
IF(JA.GT.0)GO TO 1130
IF(R2.EQ.0)GO TO 130
C FOR UP, DOWN, LEFT, RIGHT
RJJ2=J2
GO TO 1850
C GOES BACK IF NEGATIVE AND NOT IN EDIT MODE.
1130 IF(JA.EQ.223)GO TO 1500
C 223=EDIT MODE WITH I(TEM)#
IF(JA.EQ.44)GO TO 1510
C THIS '44' IS SET IN 'EDIT' - IT'S NEVER TYPED.
IF(JA.EQ.55)GO TO 1480
IF(JA.NE.190)GO TO 1860
1140 CALL HOMER
GO TO 1790
1150 IF(X22.EQ.0)GO TO 1350
C WHEN NOT IN EDIT MODE(X22=0) "P n n2" LISTS ALL PARAMS FOR ITEMS n→n2
J2=R2
TYPE 1160,J2,RJJ(J2-2)
C TYPE P n TO SEE FULL CONTENTS OF PARAM. n.
GO TO 130
1160 FORMAT(I,F15.5)
1170 IF(X22.NE.0)GO TO 260
C 'Z' = ZOOM CAN'T DO ZOOM WHILE IN EDIT MODE
JA=24
IGO=0
1180 IF(R2.LT.200)GO TO 1190
R3=AMOD(R2,100.)
R2=(R2-R3)/100.
R4=5*IFIX(9.0/R2)
C Z240 GIVES 2 40 20. Z366 GIVES 3 66 15. Z490 GIVES 4 90 10.
1190 IF(I2.GT.0)GO TO 1250
C NEXT SECTION FOR ZLn, ZRn, ZUn, ZDn. n=% OF SCREEN CHANGE OF CENTER PO
IF(R3.EQ.0)R3=RZZZ
RZZZ=R3
C SAVE R3 FOR REPEAT OF COMMAND WITHOUT n.
R3=R3/RZMSZ
C 'ZR10' MEANS MOVE CENTER OF IMAGE 10% OF SCREEN SIZE TO RIGHT.
IF(I2.NE.LRR)GO TO 1220
R3=-R3
1200 R3=RZMX+R3
R4=RZMY
1210 R2=RZMSZ
GO TO 1290
1220 IF(I2.EQ.LEL)GO TO 1200
IF(I2.NE.LUU)GO TO 1240
R3=-R3
1230 R4=RZMY+R3
R3=RZMX
GO TO 1210
1240 IF(I2.EQ.LDD)GO TO 1230
1250 JCLIP=525
C SETS CLIP LIMITS IN CLIP SUBR.
IF(R2.NE.0)GO TO 1270
IF(I2.EQ.LZZ)GO TO 1280
IGO=-1
1260 R2=1.
C TO REDISPLAY WITH MAGNIFICATION - OR JUST RUN THROUGH DATA.
1270 IF(R2.LE.1)GO TO 1290
JCLIP=511
IF(R3.NE.0)GO TO 1290
1280 CALL ZCRSOR
C 'Zn' (AND NO OTHER NUM) WHERE n >1 ALLOWS YOU SET CENTER WITH LIGHTPEN
1290 RSZ=.845*R2
RZMSZ=R2
RZMX=R3
RZMY=R4
C REMEMBER FACTORS
JCEN=0
KCEN=0
IF(R2.EQ.1)GO TO 1310
IF(R2.LT.1)GO TO 1300
JCEN=(R3*10-500)*RSZ
KCEN=(R4*10-480)*RSZ
C NEXT TO RECONSTITUTE SPACING SCALE.
1300 R2=(R4-100.)/100.
C%%%%%%%%%%%%%
IF(R2.LT.0)R2=0
C WE DON'T WORRY IF IT'S TOO HIGH (YET).
1310 R4=0
C**** NO SCALE AT IRCAM, TOO MESSY! CALL SCL
R2=0
R3=0
R4=0
CXX LCEN=0
CXX MCEN=0
C IF P5 ⎇ 0 GOES THROUGH DATA IN OLD WAY.
JFONT=0
1320 M=1
I=PWDS(ITEM+1)
ITEMX=ITEM
C FOR USE IN CENTERING WHOLE RESTS (IN NOTWRT [NTSM.FAI])
ITEM=0
1330 ST2=0
CALL DPYCLR
1340 NDP=0
1345 PLT=1
EDQ=0
IF(JA.EQ.0)GO TO 2370
IF(JA.NE.24)IGO=0
GO TO 2370
1350 IF(I2.EQ.LRR)GO TO 1360
C NOW TYPE 'PR' TO PRINT PARAMETER LIST
R5=42
IF(I2.EQ.IBLA)GO TO 890
IF(I2.EQ.LPP)RD=41
C PPP=40 PP=41 P=42 POCO=72 PIU=91
IF(I2.EQ.LII)RD=91
IF(I2.EQ.LOH)RD=72
IF(I2.EQ.LEL)GO TO 780
C PLUS
IF(I2.EQ.LZZ)GO TO 1370
C PIZZ
IF(I3.EQ.IBLA)GO TO 880
RD=40
GO TO 500
1360 CALL NUMLTR(2,K)
CALL LISTP(LST)
GO TO 130
1370 RA=51857895.
RB=95389999.
C PIZZ.
1380 RD=0
1390 RE=1
1400 IF(I2.NE.IBLA)CALL NUMLTR(2,J)
C NUMLTR SENDS BACK STUFF IN R2,RJQ (2=SKIPS 2 LETTERS)
J=16
R6=RA
R7=RB
R8=RD
IF(R5.EQ.0)R5= RE
IF(R4.EQ.0)R4=14
C 0=PUT IT ABOVE STAFF
GO TO 900
1410 RA=51704789.
RB=74828584.
RD=99999999.
C A TEMPO
GO TO 1390
1420 RA=51708772.
RB=84999999.
C ARCO
GO TO 1380
1430 RA=40999999.
1440 RB=0
GO TO 1380
C LEFT AND RIGHT PARENTHESES AND COMMA
1450 RA=41999999.
GO TO 1440
1460 RA=36999999.
RB=0
RD=0
RE=1.5
C COMMA IS DEFAULT SIZE 1.5
GO TO 1400
1470 NDP=WDS(X22)
CALL REPVEC(NDP,WDS(X22+1)-1,WDS(ITEM))
C REPLACES VECTORS V1-V2 WITH V3-END IN DISPLAY BUFFER.
NDP=NDP-1
IF(IGO.GE.0)GO TO 1475
C DON'T DO DPYOUT WHILE IN "A" MODE. (GROUP EDIT, ALTER MODE)
CALL DPYOUT(NDP)
C NOW DISPLAY ALL FROM CHANGE ON TO END OF DPY BUF.
DPYIT=0
CALL CLRCUR
1475 CALL JUGGLE
C JUGGLE WDS, PWDS, AND RN ARRAYS, RESET VECTOR COUNT
CALL VECCNT(ST2)
CXX IF(JA.NE.0)CALL DPYNEW
C JA=0 MEANS EXIT FROM EDIT, THEN MOVE CURSOR ON TO NEXT ITEM.
CHNG=0
C RESET CHANGE FLAG - CLEAR EDIT MODE ERROR TRAP
IF(JA.EQ.223)GO TO 1690
C FOR MOVING DIRECTLY TO NEW ITEM IN EDIT MODE.
IF(ZERO)GO TO 120
X22=ZERO
ZERO=-1
IF(JA.EQ.55)GO TO 1480
IF(JA.EQ.44)GO TO 1510
IF(KED.NE.0)GO TO 1530
GO TO 1700
C 55,POS -- SETS UP ALIGNMENT
1480 IF(I2.NE.LSS)GO TO 1490
CALL EXCH(R2,R3)
J3=R3
C 'ES' IS "EDIT, STAFF, POS., CODE"
C 'ED' IS "EDIT, POS., STAFF, CODE"
1490 K=(RHORZ(R2)*RSZ)-JCEN
CALL CUR1(K)
C GO DRAW VERT. LINE
KED=-1
CXXX IRCAM IF(J4.EQ.0)KED=-1
RITEM=R4
C FOR 'ED POS., STF., CODE#' (STF > 7 = ALL STAVES)
IF(J3.GT.7)KED=-2
RLINE=R2
R2=R3
GO TO 1520
C '223,0' EDITS LAST ITEM ENTERED
1500 REDIT=999.0
IF(R2.NE.0)GO TO 1550
X22=ITEM
IF(IOLD.EQ.0)GO TO 1710
IF(IOLD.LE.ITEM)X22=IOLD
GO TO 1710
1510 KED=1
RITEM=R3
C 'ST*, STF#, CODE# (IF 0, ALL ITEMS COME UP) - STF>7 = ALL STAVES.
IF(R2.GT.7)KED=2
1520 REDIT=R2
C THE STAFF #
JED=1
1530 IF(EDX(RLINE).GE.0)GO TO 1670
CC244 X=ITEM
CC IF(JED.GT.X)GO TO 444
CC DO 144 K=JED,X
CC L=PWDS(K)
CC IF(KED.EQ.-2)GO TO 654
C -2 LOOKS AT ALL ITEMS NEAR VERT. LINE, -1 ON SINGLE STAFF.
CC IF(KED.EQ.2)GO TO 656
CC IF(RN(L+2).NE.REDIT)GO TO 144
CC IF(KED)GO TO 654
CC IF(RITEM.EQ.0)GO TO 655
CC656 IF(RITEM.NE.RN(L+1))GO TO 144
CC655 IF(JA.NE.55)GO TO 344
CC654 IF(ABS(RLINE-RN(L+3)).LT.5.0)GO TO 344
CC144 CONTINUE
CC444 REDIT=999.
C NO MORE ON LINE
CC R2=0
C SO IT WILL RETURN IF NOTHING IS FOUND WITH 'ED' OR 'ST'.
CC GO TO 73
CC344 JED=K+1
C FOR NEXT TIME AROUND
CC X22=K
GO TO 1710
C CR MOVES ALONG GIVEN LINE, 222 LEAVES THIS MODE
1540 IF(I.EQ.IX)ITEM=ITEM-1
GO TO 1560
1550 IF(X22.GT.0)GO TO 1610
1560 IF(R2.NE.0)GO TO 1690
IF(JA.NE.0)MINUZ=0
IF(REDIT.EQ.999)GO TO 1570
IF(JA.GT.0)GO TO 1530
1570 IF(JA.GE.0)GO TO 1580
X22=X22+JA
C FOR TYPING '-n'
GO TO 1600
1580 IF(I1.EQ.PLUS)MINUZ=0
IF(I1.EQ.MINUS)MINUZ=-1
C TYPE '-' WITH NO NUM. TO BACKUP WITH CRLF ONLY
C TYPE '+' TO GO FORWARD
IF(MINUZ.LT.0)GO TO 1590
IF(REDIT.NE.999.)GO TO 1530
C JUMP IF IN 'ED' OR 'ST' MODES
X22=X22+1
GO TO 1700
1590 X22=X22-1
1600 IF(X22.LT.1)GO TO 1670
C EXIT FROM EDIT MODE IF GONE OFF BOTTOM
GO TO 1700
*******
CC1554 X22=X22+1
CC IF(JA.EQ.0)GO TO 4554
CC X22=X22-1+JA
CC GO TO 5554
CC4554 IF(I1.NE.MINUS)GO TO 3554
CC MINUZ=-1
C TYPE '-' WITH NO NUM. TO BACKUP WITH CRLF ONLY
CC3554 IF(MINUZ.LT.0)X22=X22-2
CC IF(X22.LT.1)X22=1
CC GO TO 425
C FOR EDITING
1610 IF(JA.EQ.55)GO TO 1800
1620 IF(JA.NE.223)GO TO 1630
C 'I, #' WILL MOVE TO ANOTHER ITEM WHEN ALREADY IN EDIT MODE.
KED=0
JED=0
GO TO 1650
1630 IF(JA.EQ.44)GO TO 1800
C FOR '24' WHILE IN EDIT MODE. MAGS WITH CURSOR AS CENTER.
IF(JA.GT.100)GO TO 1640
IF(JA.GT.13)GO TO 130
C PARAM NUM TOO HIGH? LOOKS FOR NEXT ITEM TO EDIT IF <CR>
1640 IF(X22.EQ.0)GO TO 1720
IF(R2.NE.0)GO TO 1720
C BACKS UP WHEN IN EDIT MODE.
IF(JA.GT.0)GO TO 1730
IF(I.EQ.IX)GO TO 1540
IF(CHNG.NE.0.AND.JA.LT.0)GO TO 130
C CAN'T DO '-N' AND OTHER THINGS AFTER CHANGES IN EDIT MODE.
ZERO=X22+1
C '0' AFTER AN EDIT ENDS THE EDIT AND GETS NEXT ITEM FOR EDIT.
1650 IF(X22.EQ.0)GO TO 120
IF(KED.EQ.0)REDIT=999.
1660 IF(I.NE.IX)GO TO 1470
ITEM=ITEM-1
C TO DELETE AN ITEM
1670 X22=0
CXX IF(CHNG.NE.0)DPYIT=-1
DPYIT=CHNG
NDP=WDS(ITEM+1)-1
C NO NEED TO REDRAW DPY AT THIS POINT.
MINUZ=0
C MINUS SIGN FLAG (WHEN -1, CRLF=BACKUP)
CHNG=0
C RESET CHANGE FLAG
IF(I1.NE.LEE)CALL CLRCUR
C CLEAR CURSOR UNLESS GETTING HERE FROM FAILED "ED N" COMMAND.(LEAVE LINE)
IF(JA.EQ.44.OR.JA.EQ.55.OR.JA.EQ.223.OR.R2.NE.0)GO TO 1675
C ONLY WHEN DELETING, EXITING OR COPYING. JA=99,222,2222
1675 IF(REDIT.EQ.999.)GO TO 1680
IF(JA.EQ.55)GO TO 1480
IF(JA.EQ.44)GO TO 1510
1680 IF(R2.EQ.0.OR.R2.GT.ITEM)GO TO 120
C DELETION IN EDIT MODE DOES NOT LEAVE MODE.
1690 X22=R2
1700 IF(X22.GT.ITEM)GO TO 1670
C LEAVES EDIT MODE.
1710 CALL BOXX
DPYIT=0
C DOES A DPYOUT WHEN DRAWING CURSOR.
CC429 IX=I
CC MEDIT=PWDS(X22)
CC J=2
CC426 Y=RN(MEDIT)+J
CC CALL LOOP(0,Y,1,I,MEDIT,RN)
CC JJA=RN(I+1)
CC YED=Y-2
CC L=I+2
CC DO 422 K=1,11
CC IF(K.GT.YED)GO TO 423
CC RJJ(K)=RN(L+K)
CC GO TO 422
CC423 RJJ(K)=0
CC422 CONTINUE
CC RJJ2=RN(L)
CC IF(IGO.GT.0)GO TO 4231
C NO BOX WHEN IN GROUP EDIT ROUTINE
CC IBOX=I
CC RBOX=RJJ2
CC CALL BOX(IBOX,RBOX)
CC4231 ITEM=ITEM+1
CC ST2=WDS(ITEM)
GO TO 120
1720 IF(JA.EQ.0)GO TO 1850
1730 X=100-JA
IF(X)JA=JA/100
IF(JA.LE.2)GO TO 1820
CALL EQUAL(X)
CC IF(JA.LE.13)GO TO 324
CC JA=JA/10
C ADD 1000 TO PARAM TO MAKE EQUAL TO ANOTHER PARAM
CC X=R2-2.
CC RJJ(JA-2)=RJJ(X)
CC GO TO 6222
CC324 I1=JA-2
CC IF(X)GO TO 224
CC RJJ(I1)=R2
CC GO TO 6222
CC224 RJJ(I1)=RJJ(I1)+R2
GO TO 1840
1740 IF(X22.EQ.0)GO TO 1770
C 'C' = COPY (IN OR OUT OF EDIT MODE) CR=CRESC.
CC IF(I2.EQ.IBLA)GO TO 883
IF(I2.NE.IBLA)GO TO 1760
1750 IF(CHNG.EQ.0)GO TO 130
C CAN'T 'COPY' UNLESS CHANGES WERE MADE.
IOLD=0
GO TO 650
1760 IF(R2.NE.0)GO TO 1750
C IS THERE A NUMBER AFTER C
R2=1
C CN=CENTER, CH=AT HEAD, CT=AT TAIL, CX=EXIT FROM CENTERING MODE.
JA=13
IF(I2.EQ.IXX)R2=0
IF(I2.EQ.LHH)R2=-R2
IF(I2.EQ.LTT)R2=-2
IF(I2.EQ.LBB)CB=6
IF(I2.EQ.LVV)CB=-1
IF(I3.EQ.LVV)CB=CB-10
C TYPE 'CB' FOR CENTER-BIG (BIG RANGE =6) ****** 'CV'=SET CURVE OF SLU
C CBV, CHV, CTV WILL SET CURVE AND DO CENTERING.
GO TO 1110
CC278 IF(X22.NE.0)GO TO 59
1770 IF(I2.EQ.IBLA)GO TO 1780
C NEXT FOR ME=MENO=81 MOLTO=90 CRESC.=70 MP=43 MF=50, ALSO 'MACRO'
RD=43
IF(I2.EQ.LAA)GO TO 2400
IF(I2.EQ.LFF)RD=50
IF(I2.EQ.LOH)RD=90
IF(I2.EQ.LEE)RD=81
IF(I2.EQ.LRR)RD=70
GO TO 880
1780 CALL MOVER
IF(R2.GE.99)GO TO 260
C 99(+)=BACKUP OUT OF MOVER ETC.
IGO=0
JFONT=0
C SO IT WON'T DO ALL FONT LOOKUPS.
1790 IF(JJ2)GO TO 130
M=PWDS(JJ2)
I=PWDS(ITEM+1)
ITEM=JJ2-1
C SO IT DOESN'T HAVE TO GO THROUGH ALL ITEMS
CALL DELVEC(WDS(JJ2),0)
ST2=WDS(JJ2)-1
C CURRENTLY MUST REDISPLAY ALL AFTER A MOVE, ETC.
GO TO 1340
1800 REDIT=0
IF(I2.NE.IBLA)GO TO 1660
C WE GET HERE WHEN TYPING 'ST' OR 'ED' WHEN ALREADY IN EDIT MODE.
IF(R2.EQ.0)GO TO 1810
IF(CHNG.NE.0)GO TO 130
C CATCH 'S'ET AFTER A CHANGE WAS MADE.
GO TO 1660
C GO PAST HERE ONLY FOR 'A'LIGN
1810 IF(KED.GE.0)RLINE=RJ3
RJ3=RLINE
GO TO 1840
C FOR '55' ALIGNING
1820 IF(X)GO TO 1830
CALL PARCH(JA,JJA,R2)
GO TO 1840
1830 RJJ2=R2+RJJ2
C ARRAYS NEED 2O LOCATIONS HERE.
C CHNG PARAMS WITH PAIRS OF NUMS.(EG. 2,122 4,13 5,-2 ETC.)
1840 CALL RJED
1850 CALL RJED2
C BELOW IS NOW IN 'LOOP.FAI'
CC6222 DO 1222 K=1,20,2
CC L=JQ(K)
CC IF(L.EQ.0)GO TO 6221
C '600 2' WILL ADD 2 TO PARAM 6. '3000 6' SETS P3=P6.
CC RD=RJQ(K+1)
CC X=L
CC IF(L.LT.100)GO TO 223
CC IF(L.LT.2000)GO TO 5223
CC X=L/1000
CC L=JQ(K+1)-2
CC RD=RJJ(L)
CC GO TO 2223
CC5223 X=L/100
CC IF(X.EQ.2)GO TO 1223
CC RD=RJJ(X-2)+RD
CC GO TO 2223
CC1223 RD=RJJ2+RD
CC223 IF(X.LE.2)GO TO 3223
CC2223 RJJ(X-2)=RD
CC GO TO 1222
CC3223 CALL PARCH(X,JJA,RD)
C NOW P1 CAN BE CHANGED IN EDIT MODE -- BE CAREFUL,,,,!!!!!!
CC1222 CONTINUE
C*** LOOP SET TO 11 (20 IN ARRAY!) ONLY 13 PARAMS POSSIBLE NOW.
CC6221 DO 5514 K=1,11
CC R2=RJJ(K)
CC RJQ(K)=R2
CC5514 JQ(K)=R2
CC R2=RJJ2
CC JA=JJA
CC ITEM=ITEM-1
CC IF(ITEM)ITEM=0
ST2=WDS(ITEM+1)
CALL DELVEC(ST2,0)
NDP=ST2-1
ST2=ST2-1
I=PWDS(ITEM+1)
IF(X22.EQ.0)GO TO 1860
CXX DPYIT=-1
CHNG=-1
1860 J2=R2
IF(J2.LT.0)GO TO 130
IF(J2.GT.7)GO TO 130
C STOPS TYPO ERROR ON STAFF NUM. (<0, >7)
RSTJ2=RSTFAC(J2)
C* IF(JA.NE.2)GO TO 163
C* IF(R8.EQ.0)GO TO 163
C* IF(R8.EQ.-1)GO TO 163
C* IF(R8.EQ.-4)GO TO 163
C R8=0=AS IS; -1=WHOLE REST; >0=NUMBER OVER REST; -2=CENTERED
C R8=-3 = CENTERED REST (BUT NOT CHANGED TO WHOLE)
C R8=-4 = MEASURE REPEAT SIGN. =-5 = REPEAT SIGN CENTERED.
C* K=ITEM
C ITEM+1 IS CURRENT ITEM IN QUICK RUN-THROUGHS.
C* IF(X22.NE.0)K=X22-1
C* RD=1.75*RSTJ2
C* L=PWDS(K+2)
C* IF(RN(L+1).NE.4)GO TO 164
C GO ON IF NEXT ISN'T BAR LINE (CODE 4. NEXT FINDS OTHER LINES!!)
C* IF(RN(L+2).NE.R2)GO TO 164
C* RB=RN(L+3)
C* L=PWDS(K)
C CHECK PREV. AND NEXT ITEM. IF NOT BAR, DON'T TRY TO CENTER!
C* IF(RN(L+1).NE.4)GO TO 164
C* IF(RN(L+2).NE.R2)GO TO 164
C JUMP IF NOT ON SAME STAFF
C* RA=RN(L+3)
C* R3=RA+(RB-RA)/2-1.75*RSTJ2
C*164 IF(PLT.EQ.0)GO TO 160
C* RN(PWDS(K+1)+3)=R3
C ******* A DANGEROUS PLACE. KEEP TRACK OF THIS
C* GO TO 5541
1870 IF(JA.EQ.16)GO TO 1910
IF(PLT.NE.0)GO TO 2080
IF(JA.NE.2)GO TO 1880
IF(R8.NE.0)GO TO 2010
IF(R9.NE.0)R9=0
GO TO 2010
1880 IF(JA.NE.8)GO TO 1900
IF(R9.NE.1)GO TO 2010
L=7
K='INST.'
C RJQ(7) IS R9
1890 RA=RN(MEDIT+L+2)
CALL TYPCHR(RA,5)
CALL TYPCRL
CALL TYPSTR('TYPE ')
CALL TYPCHR(K,5)
CALL TYPSTR(' NAME ')
READ(IDEV,FA5)RD
CALL LO2UP(RD)
RJQ(L)=RD
IF(RD.NE.' ')GO TO 2010
IF(RN(MEDIT).LT.L)RA=0
C RESTORES NAME IF THERE WAS ONE ALREADY. ELSE=0
RJQ(L)=RA
C WHEN P9=1 ASKS FOR ID NAME FOR THE STAFF (FOR PART EXTRACTOR)
GO TO 2010
1900 IF(JA.NE.11)GO TO 2010
C ↑↑↑↑ WAS - TO 63
IF(J10.NE.1)GO TO 2010
K='FILE'
L=8
C P10←1 GETS NAME OF BASIC DRAW FILE, PUTS IT IN P10 (NJR)
GO TO 1890
C IF NO NAME ASKED FOR, IT TAKES LAST NAME GIVEN.(SOLVES SORT PROB?)
1910 RD=R5
IF(RD.GE.100)RD=RD-100
C ADD 100 TO SZ TO MAKE TEXT APPEAR IN ALL SEPARATE PARTS OF ORCH. SCORE
IF(J10.EQ.0)GO TO 2000
L=ITEM
IF(X22.NE.0)L=X22-1
IF(J10.EQ.1)GO TO 1980
C TEMP. FIX TO CNVT TEXT FORMAT TO NEW STYLE. "10 99"
IF(J10.NE.99)GO TO 1950
X=PWDS(X22)+6
DO 1920 L=X,X+2
RB=RN(L)
K=RB
C CHECKS TO SEE WHICH FORMAT
1920 IF(K.NE.RB)GO TO 1930
GO TO 70
1930 DO 1940 L=X,X+2
1940 RN(L)=RN(L)*100.
GO TO 70
C NEXT FOR CENTERING TEXT. P10>1
1950 RB=0
X=PWDS(L+1)
1960 L=L+1
K=PWDS(L)
RB=RB+RN(K+9)
C ADD SPACE NEEDED
K=PWDS(L+1)
IF(RN(K+1).NE.16)GO TO 1970
IF(RN(K).EQ.8)GO TO 1960
C GO BACK IF MORE LETTERS TO COME
1970 R3=R10-(RB-3.4)*RD*RSTJ2/2.
C +3.4 IS TO COMPENSATE FOR STARTING POS. BEING IN CENTER OF LET.
R10=0
IF(RN(X).EQ.8)RN(X+10)=0
RN(X+3)=R3
C THESE ARE NEEDED FOR ITEMS CENTERED DIRECTLY FROM 'WORDS'
GO TO 2000
1980 K=PWDS(L)
R3=AMOD(RN(K+5),100.)*RSTJ2*RN(K+9)+RN(K+3)
C AMOD BECAUSE P5+100 IS USED FOR PARTS PROGRAM.
R4=RN(K+4)
R5=RN(K+5)
R2=RN(K+2)
J2=R2
L=PWDS(L+1)
DO 1990 JJA=3,5
1990 RN(L+JJA)=RJQ(JJA-2)
RN(L+2)=R2
2000 IF(PLT.NE.0)GO TO 2080
2010 RJ3=R3
JJA=JA
IF(R8.NE.0)GO TO 2020
IF(JA.EQ.1)R8=999.
C 999=0 FOR STEM EXTENSIONS.
C USES ONLY 10 PARAMETERS BEYOND JA, J2
2020 CALL MSSLUP
IF(JA.NE.6)GO TO 2040
CX I DON'T THINK THIS NEXT IS NEEDED NOW. 9/78 IF(J13.EQ.0)GO TO 171
CX R2=X22
CX X22=0
CX R3=R13
CX J3=J13
CX R4=R11
C RESET HOMING RANGE (DEFAULT=3) WITH P11.
CX CALL CLRCUR
CX R13=0
C TYPE 13, n WITH BEAMS TO ADJUST IN RE. TO OTHER STAFF(LIKE OLD 'AD')
CX JA=190
CX GO TO 271
2030 CALL HOMER
2040 IF(R13.EQ.0)GO TO 2070
RD=R11
IF(CB.EQ.0)GO TO 2050
C *** CB = CENTER-BIG I.E. BIG RANGE FOR CENTERING -- 6 UNITS. (CAN VAR
X=CB+10
IF(CB.LT.-1)CB=X
C CBV NOW=-4, CHV AND CTV =-10
IF(RD.EQ.0)R11=CB
IF(JA.NE.5.OR.CB.GT.0)GO TO 2050
C *** CV = SET CURVE OF SLUR. (FOR USE AFTER SPACE CHANGES, ETC.)
R7=RCURVE(R3)
CC R7=0.9+(R6-R3)/25.+ABS(R4-R5)/10.
C SAME FORMULA AS FOUND IN SLURZ ROUTINE. FUNCTION CURVE IS IN LOOP
CC IF(R7)RB=-RB
CC DONE IN 'RCURVE'*** R7=RB
RJ7=R7
IF(X.GT.0)GO TO 2060
2050 CALL HOMER
2060 CB=0
R11=RD
C R11 GETS CHANGED IN 'HOMER'
CC IF(JA.EQ.2.AND.R9.NE.0)CALL RSTCEN
C RSTCEN IS FOR CENTERING WHOLE RESTS.
IF(JA.EQ.10)R3=R3+RSTJ2
IF(JA.NE.9)GO TO 2070
IF(J5.GT.3)GO TO 2070
CALL NOZERO(R6)
R3=R3+RSTJ2+2.*RSTJ2*R6
C ABOVE HELPS CENTER NUMBERS UNDER NOTES(BECAUSE R3 IS AT CENTR OF NUM)
C IF P13⎇0 ANY ITEM WILL LINE UP WITH ANY OTHER ITEM. P13 IS RESET=0
C P13=-1 POSITIONS ITEM ABOVE OR BELOW NOTE, =-2 JUST BEYOND STEM.
C CODE 10 (NUMBERS) SPACED TO LEFT AS WELL AS CODE 9, P5=1,2,3 (FLAT,SHR
C **** FOR '0' EDITS ******
2070 CALL LUP2
2080 IF(DP(J2).GE.0)GO TO 2090
IF(JA.NE.8)GO TO 70
C NOW GET SIZE FACTOR, IF IT'S THERE. (NEEDED IN 'SCORE' SECTION.)
IF(R5.NE.0)RSTFAC(J2)=R5
GO TO 70
C*** 3/74 NEW DP SYSTEM
C WHAT ABOUT EDITS?*******
2090 POS=STFF(J2)
RX3=R3
C SAVES IT IN RJQ(20) FOR OTHER ROUTINES.
J3=ROFF(RHORZ(R3))
C LINE IS DIVIDED INTO 200 POINTS.
CALL CENTX
C SETS VERT.(CENTR) POSITION BASED ON STAFF AND R4
R3=J3
IF(JA.LE.2)GO TO 60
2100 GO TO(2431,2431,2130,2210,2140, 2190,2150,2180,60,2120, 2130,2200)
1,JA
GO TO (2150,2160,2170),JA-15
C FOR 16,17,18 (WORDS, KSIG, METER)
IF(JA.EQ.99)GO TO 70
C FOR PART EXTRACTOR TRANSPOSER - KEY SIG=0
IF(JA.NE.33.AND.JA.NE.44)GO TO 2110
JA=JA/11
C THIS IS TEMPORARY - TO READ PAGE TEMP. FILES.
GO TO 2100
2110 I=PWDS(ITEM+1)
GO TO 130
C 44 1; JFONT=ONE DISPLAYS FONTS - THIS ALSO CATCHES SOME TYPOS
2120 CALL MAKNUM(R5)
GO TO 70
2130 CALL CLEFS
GO TO 70
2140 CALL SLUR
GO TO 70
2150 CALL ALPHA
GO TO 70
2160 CALL KSIG
GO TO 70
2170 CALL METER
GO TO 70
2180 IF(R2.EQ.0)RMOV=R8
CALL STAFF
GO TO 70
CC625 IF(J10.LT.100)GO TO 1625
CC CALL BEAMX
CC GO TO 160
2190 CALL BEAMX
CC625 CALL BMSTF
GO TO 70
C BEAMS, STAFF LINES ****
2200 CALL CIRCLE
GO TO 70
2210 CALL ITMSUB
C BAR LINES, ETC.
GO TO 70
C TO GET DISPLAY: 'G'; 'GM' ADDS TO DPY;
CC120 IF(X22.NE.0)GO TO 59
C GO BACK IF STILL IN EDIT MODE
2220 J2=0
IF(I.EQ.1)GO TO 2230
L=NAME
X=EXT
IF(I2.EQ.IBLA)GO TO 2110
J2=-1
I2=(I2-'0')/536870912
C TURN ASCII INTO INTEGER.
IF(I2.GT.9.OR.I2.LT.0)GO TO 2230
C VERT. STEPS PER INCH = 23.9 (CONSIDER STAFF SIZE FACTOR TOO)
R2=I2
J2=1
C 'GM'=GET MORE(BUT OLD OUTPUT NAME IS RESTORED AT 2207)
C 'Gn'=GET MORE AND PUT IT ON STAFF n AT POS. OF STAFF 0'S P8.
C ANYTHING AFTER 'G' BUT A NUMBER IS TAKEN AS 'GM'.
2230 I1=-1
CALL NAMEXT(INP,NAME,EXT)
C NOW TYPE 'G NAME' OR 'GM NAME'
IF(NAME.NE.IBLA)GO TO 2250
2240 CALL TYPSTR(' NAME.EXT? ')
READ(IDEV,700,END=240)INP
C GO PUT A1'S INTO A5, ETC.
CALL NAMEXT(INP,NAME,EXT)
IF(NAME.EQ.IBLA)GO TO 2270
IF(NAME.NE.'99')GO TO 2250
C TYPE '99' TO BACK OUT OF 'SAVE'.
NAME=L
EXT=X
GO TO 130
2250 IF(I1.NE.LESS)GO TO 2260
IDEV=5
GO TO 2240
2260 IF(LOOKX(NAME,EXT).EQ.0)GO TO 2240
C FUNC. LOOKD IS 'FAIL' PROG. TO CHECK ON LOOKUPS
2270 JA=-1
C -1 IS FOR 8852+3
2280 J=ITEM+1
IF(NAME.NE.IBLA)GO TO 2290
CALL GETEXT('TMP','MS')
GO TO 2300
2290 CALL GETEXT(NAME,EXT)
2300 IF(J2.EQ.0)GO TO 2310
NAME=L
EXT=X
C ABOVE GETS BACK ORIGINAL NAME WITH 'GM' AND 'Gn'
2310 RSTF=0
CALL EXTIN(RSTFAC,128)
CALL EXTIN(PWDS(J),JJ2)
CALL EXTIN(RN(I),IPOS)
ITEM=ITEM+JJ2-2
CCCC IF(J2)GO TO 2203
IF(J2)2350,2320,2330
CC IF(I2.EQ.IM)GO TO 2203
C J2=-1,1=GM *******'GET MORE' DOES NOT GET MOTIVE LIST OF NEW FILE.****
2320 IF(LCNT.GT.1)CALL EXTIN(LIST,LCNT)
I=IPOS
IF(RSTF.EQ.0)GO TO 1320
C (END OF V ARRAY)RSTF=-1 MEANS READ THE DPY BUFFER
CCC CALL EXTIN(ST,4302)
CCC CALL DPYNEW
GO TO 130
2330 DO 2340 K=1,ITEM
IF(RN(PWDS(K)+1).NE.8)GO TO 2340
J3=PWDS(K)
IF(RN(J3+2).NE.0)GO TO 2340
R8=RN(J3+8)
C ASSUMES SPACE INFO IS IN P8. GET IT.
C NEXT FOR VERTICAL SPACING OF NEW STAFF TO BE READ.
R5=23.9/RSTFAC(0)
R3=.73*R2
C INCHES BETWEEN STAVES=.73
R4=(R8-R3)*R5
C R4=CHANGE FROM NORMAL POSITION FOR INCOMING STAFF.
GO TO 2350
2340 CONTINUE
C IF NO STAFF 0 WAS FOUND R4=0
R4=0
2350 M=I-1
DO 2360 K=J,J+JJ2-2
PWDS(K)=PWDS(K)+M
IF(J2.LE.0)GO TO 2360
C NEXT FOR GET-MORE AND PUT ON STAFF #R2
J3=PWDS(K)
RN(J3+2)=R2
IF(RN(J3+1).NE.8)GO TO 2360
RN(J3+4)=R4
C SET HEIGHT OF STAFF - DEPENDANT UPON P8 OF STAFF 0.
CCC IF(RN(J3).GE.6)RN(J3+8)=0
C ZERO SPACING PARAM IN UPPER STAVES.
2360 CONTINUE
GO TO 1320
M=IX
C IF P5=0 MOVES UP AT START, IF P6=0 MOVES UP AT END.
C (J8) P8=1 OR 2 FOR 2-PASS PLOTS
C 1.24 AND 1.2 ARE TO FIT 8 1/2 X 11 FORMAT
C RMOV HAS INCHES FROM P8 OF STAFF 0.
C R6=1 FOR NO MOVE AT END. R7=INCHES TO MOVE FOR NEW STAFF 0.
C RE. R7:DISTANCE IS MEASURED FROM BOTTOM LINE OF STANDARD POSITION
C OF STAFF 0 UP TO LOWEST!! POINT FOUND IN FOLLOWING FILE. THEN
C NEXT SHIFT IS AGAIN FROM STANDARD STF.0 TO NEXT FILE'S LOW POINT.
C MOVES PLOTTER UP IF P5=0.
C NEXT RUNS THROUGH DATA WITH NEW CHANGES.
2370 IF(M.GE.I)GO TO 2390
IF(IGO.EQ.0)GO TO 2380
C USE "Z" TO DO FIXUP WHEN LIST IS SCRAMBLED !?X@!ZQ
IF(M.EQ.PWDS(ITEM+1))GO TO 2380
K=ITEM+1
CALL TYPSTR(' FIXING ITEM ')
CALL TYPINT(K)
CALL TYPCRL
CCCC TYPE 7122,K
CCC7122 FORMAT(' FIXING ITEM ',I3)
PWDS(K)=M
2380 CALL RUNTHR(M)
CCC EDQ ALWAYS IS EITHER 0 OR -1 IF(EDQ.LE.0)GO TO 1860
GO TO 1860
CCC GO TO 130
2390 M=1
IF(PLT.EQ.1)EDQ=-1
PLT=0
GO TO 130
C ALWAYS START PLOT WITH BOTTOM UNIT ON PAGE AND WORK UP.
2400 CALL TYPSTR(' MACRO FILE NAME= ')
ACCEPT 190,K
IF(K.EQ.'99')GO TO 130
C TYPE 99 TO BACKUP.
CALL LO2UP(K)
IF(K.EQ.IBLA)K='MACRO'
CALL OFILE(1,K)
CALL TYPSTR(' END MACRO WITH * ')
CALL TYPCRL
2410 ACCEPT 700,INP
IF(I1.EQ.ISTAR)GO TO 2420
WRITE(1,700)INP
GO TO 2410
2420 END FILE 1
CALL TYPSTR(' MACRO=')
CALL TYPWRD(K)
CALL TYPSTR('.DAT ***** RUN IT? ')
ACCEPT 700,I1
CALL LO2UP(I1)
IF(I1.EQ.LYY)GO TO 220
GO TO 130
2430 FORMAT(I,24F)
CCC56 FORMAT(/1XA5,' TYPE FOR ITEM #',I3,I,I6/)
CCC21 FORMAT(' NAME.EXT? '$)
2431 END